perm filename FASTGS[CMP,WD] blob
sn#014780 filedate 1972-11-24 generic text, type T, neo UTF8
(DECLARE (READ) (READ))
(DFUNC (GETSLOT NO)
(COND ((NOT (NUMBERP NO)) (COMPERR NOTSLOT-GETSLOT))
((GREATERP NO NACS) (PRINTMSG NO) (COMPERR NOTAC-GETSLOT))
((GREATERP NO 0) (NTHCDR (SUB1 NO) ACS))
((GREATERP (ABS NO) (PDLDEPTH)) (PRINTMSG NO)
(COMPERR NOTONPDL-GETSLOT))
((NTHCDR (MINUS NO) PDL))))
(PROG NIL LOOP (COND ((NULL (READ)) (RETURN NIL))) (GO LOOP))
(OPS (MOVNS 213000) (SUBI 275000) (JUMPLE 323000) (HRREI 571000))
(LAP GETSLOT SUBR)
(HRREI 1 -577777 1)
(JUMPLE 1 NEGATE)
(SUBI 1 1)
(MOVE 2 (SPECIAL ACS))
(JCALL 2 (E NTHCDR))
NEGATE (MOVNS 0 1)
(MOVE 2 (SPECIAL PDL))
(JCALL 2 (E NTHCDR))
NIL
(DECLARE (READ) (READ))
(DFUNC (NTHCDR NUM EXP)
(PROG NIL
(COND ((MINUSP NUM) (COMPERR NEGNUM-NTHCDR)))
LOOP (COND ((ZEROP NUM) (RETURN EXP)))
(COND ((ATOM EXP) (COMPERR ATOM-NTHCDR)))
(SETQ EXP (CDR EXP))
(SETQ NUM (SUB1 NUM))
(GO LOOP)))
(PROG NIL LOOP (COND ((NULL (READ)) (RETURN NIL))) (GO LOOP))
(OPS (SOJA 364000))
(LAP NTHCDR SUBR)
LOOP (JUMPE 1 END)
(HRRZ 2 0 2)
(SOJA 1 LOOP)
END (MOVE 1 2)
(POPJ P)
NIL